home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MAIL.SWG / 0014_Handle QWK REP Files.pas < prev    next >
Pascal/Delphi Source File  |  1993-11-21  |  4KB  |  108 lines
  1. {
  2. From: FRANK MCCORMICK
  3. Subj: qwk code
  4.  
  5.     Here is some QWK code I pulled from my UNIT which handles QWK REP
  6.     files uploaded to my BBS.
  7.  
  8.     I have modified it to display the info contained in the REP file
  9.     (which is really just a compressed version of messages.dat)
  10. }
  11.  
  12. PROCEDURE HandleRep;
  13.  
  14. Type
  15.     RepFmt =  RECORD
  16.                   totype  :  CHAR;
  17.                   confasc :  ARRAY [1..7] OF CHAR;
  18.                   date    :  ARRAY [1..8] OF CHAR;
  19.                   TIME    :  ARRAY [1..5] OF CHAR;
  20.                   rto     :  ARRAY [1..25] OF CHAR;
  21.                   from    :  ARRAY [1..25] OF CHAR;
  22.                   sbj     :  ARRAY [1..25] OF CHAR;
  23.                   null1   :  ARRAY [1..20] OF CHAR;
  24.                   blks    :  ARRAY [1..6]  OF CHAR;
  25.                   flag    :  CHAR;
  26.                   conf    :  INTEGER;
  27.                   null2   :  ARRAY [1..3]  OF CHAR;
  28.               END;
  29.  
  30. CONST
  31.     RCDLEN          = 128;
  32. VAR
  33.     RepHdr          : RepFmt;
  34.     Buffer          : ARRAY [1..128] OF CHAR;
  35.     FileRec         : ARRAY [1..RCDLEN] OF CHAR;
  36.     Rcdno,mode      : INTEGER;
  37.     RepFile         : FILE;
  38.     Success         : WORD;
  39.     MsgWriteError   : INTEGER;
  40.  
  41. PROCEDURE NextReply (VAR Rcdno: INTEGER);
  42.  
  43. VAR   Nblocks, i, start,err: INTEGER;
  44.     TempStr,filler         : STRING [25];
  45.     LastLine               : STRING [130];
  46.     done, finished, bad    : BOOLEAN;
  47.     myarray                : string[7];
  48.     ch                     : char;
  49. BEGIN
  50.     Bad := FALSE;
  51.     Finished := FALSE;
  52.     BlockRead (RepFile, Buffer, 1, success);      {scrap first block}
  53.     REPEAT
  54.         FillChar(RepHdr,SizeOf(RepHdr),#32);
  55.         {$I-}
  56.         BlockRead (RepFile, RepHdr, 1, Success );  {read header}
  57.         {$I+}
  58.         Err:=IOResult;
  59.         If Err = 0
  60.         THEN
  61.         BEGIN
  62.           MyArray:='';
  63.           FOR i:=1 to 7 DO                           {Build conf #}
  64.             IF RepHdr.confasc[i] <>#32
  65.             THEN
  66.               MyArray:=Myarray+RepHdr.confasc[i];
  67.           Val(MyArray,CurrentBaseNumber,err);       { convert >Integer}
  68.         END
  69.         ELSE
  70.           BEGIN
  71.             Writeln(' ERROR Blockreading file ');
  72.             Halt(err);
  73.           END;
  74.  
  75.         (** The following DISPLAYs the header information **)
  76.  
  77.         Writeln('Base #  ',CurrentBaseNumber);
  78.         Writeln('Ref  #  ',ord(RepHdr.Flag);
  79.         Writeln('To      '+rephdr. Rto);
  80.         Writeln('Subj    '+RepHdr. Sbj);     {Get subject of message}
  81.         Writeln('Date    '+Rephdr. Date);    {Set msg date mm-dd-yy}
  82.         Writeln('Time    '+Rephdr. Time);    {Set msg time hh:mm}
  83.  
  84.         (** Now start work on actual message **)
  85.  
  86.         Tempstr := '' ;
  87.         FOR i := 1 TO 6 DO IF RepHdr. Blks [i] <> #32  {Get the # of blks }
  88.         THEN                                           {In the message}
  89.           Tempstr := Tempstr + RepHdr. Blks [i];
  90.         VAL (Tempstr, NBlocks, Success);
  91.         Done := FALSE;
  92.         FOR i := 1 TO Nblocks - 1 DO                    {do number of blocks}
  93.         BEGIN
  94.           FillChar (BUFFER, SizeOf (BUFFER), #32);
  95.           LastLine := '';
  96.           BlockRead (RepFile, BUFFER, 1, success);
  97.           LastLine := asc2STR (BUFFER, 128);          {convert from ASCII}
  98.           FOR Start := 1 TO Length (LastLine)         {string to TP string}
  99.           DO
  100.            IF LastLine [start] = #227                 {#227 in QWK paks}
  101.            THEN                                       {Marks eol}
  102.              LastLine [start] := #13;
  103.           Writeln(LastLine);
  104.        END;
  105.     UNTIL Eof(repfile) OR Finished;
  106.     close(repfile);
  107. END;
  108.